home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / triton / examples / linklib.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  7.9 KB  |  279 lines

  1. PROGRAM LinkLib;
  2.  
  3. uses exec, triton, tritonmacros, linklist,
  4.            amigautils,strings, easyasl, utility, vartags;
  5.  
  6. {
  7.    A demo in FPC Pascal using triton.library
  8.    
  9.    nils.sjoholm@mailbox.swipnet.se
  10. }
  11.  
  12.  
  13.  
  14. VAR
  15.      Project  : pTR_Project;
  16.      mylist   : pList;
  17.      llist    : pList;
  18.      pdummy   : ARRAY [0..108] OF Char;
  19.      path     : PChar;
  20.      Triton_App : pTR_App;
  21.  
  22. const
  23.  
  24.     LibListGadID   = 1;
  25.     AddGadID       = 2;
  26.     RemoveGadID    = 3;
  27.     RemAllGadID    = 4;
  28.     UpGadID        = 5;
  29.     DownGadID      = 6;
  30.     OkButton       = 7;
  31.     CancelButton   = 8;
  32.  
  33.  
  34. PROCEDURE CleanExit(errstring : STRING; rc : Longint);
  35. BEGIN
  36.     IF assigned(Project) THEN TR_CloseProject(Project);
  37.     IF Assigned(mylist) THEN DestroyList(mylist);
  38.     IF Assigned(llist) THEN DestroyList(llist); 
  39.     IF errstring <> '' THEN WriteLn(errstring);
  40.     Halt(rc)
  41. END;
  42.  
  43. PROCEDURE disablegads;
  44. VAR
  45.    dummy : Longint;
  46. BEGIN
  47.    IF NodesInList(mylist) > 0 THEN dummy := 0
  48.       ELSE dummy := 1;
  49.  
  50.    TR_SetAttribute(Project,RemoveGadID,TRAT_Disabled,dummy);
  51.    TR_SetAttribute(Project,RemAllGadID,TRAT_Disabled,dummy);
  52.    TR_SetAttribute(Project,UpGadID,TRAT_Disabled,dummy);
  53.    TR_SetAttribute(Project,DownGadID,TRAT_Disabled,dummy);
  54. END;
  55.  
  56. PROCEDURE readinlist;
  57. VAR
  58.    dummy : BOOLEAN;
  59.    temp : pFPCNode;
  60. BEGIN
  61.    dummy := FileToList('ram:fpclistoffiles',mylist);
  62.    IF dummy THEN BEGIN
  63.       temp := GetFirstNode(mylist);
  64.       IF temp <> NIL THEN StrCopy(path,PathOf(GetNodeData(temp)));
  65.       temp := GetLastNode(mylist);
  66.       IF StrLen(GetNodeData(temp)) = 0 THEN RemoveLastNode(mylist);
  67.    END;
  68. END;
  69.  
  70. PROCEDURE addfiles;
  71.  
  72. VAR
  73.   dummy    : BOOLEAN;
  74.   mynode,tempnode   : pFPCNode;
  75.   temp  : Longint;
  76.  
  77. BEGIN
  78.   dummy := GetMultiAsl('Pick a file or two :)',path,llist,NIL,NIL);
  79.   IF dummy THEN BEGIN
  80.      mynode := GetFirstNode(llist);
  81.      FOR temp := 1 TO NodesInList(llist) DO BEGIN
  82.         tempnode := AddNewNode(mylist,(PathAndFile(path,GetNodeData(mynode))));
  83.         mynode := GetNextNode(mynode);
  84.      END;
  85.      TR_UpdateListView(Project,LibListGadID,mylist);
  86.      TR_SetValue(Project,LibListGadID,0);
  87.      disablegads;
  88.      ClearList(llist);
  89.   END;
  90. END;
  91.  
  92. PROCEDURE removelib;
  93. VAR
  94.    num : Longint;
  95.    mynode : pFPCNode;
  96.    strbuf : ARRAY [0..255] OF Char;
  97.    buffer : PChar;
  98.    dummy : Longint;
  99. BEGIN
  100.    buffer := @strbuf;
  101.    num := TR_GetValue(Project,LibListGadID);
  102.    mynode := GetNodeNumber(mylist,num);
  103.    
  104.    dummy := TR_EasyRequest(Triton_App,'Sure you want to delete'+#10+
  105.                             strpas(GetNodeData(mynode)),'_Remove|_Cancel',TAGS(
  106.                             TREZ_LockProject,longint(Project),
  107.                             TREZ_Title,longstr('Delete this file?'),
  108.                             TREZ_Activate,longint(byte(True)),
  109.                             TAG_END));                                            
  110.    IF dummy = 1 THEN BEGIN
  111.       DeleteNode(mynode);
  112.       TR_UpdateListView(Project,LibListGadID,mylist);
  113.       TR_SetValue(Project,LibListGadID,0);
  114.       disablegads;
  115.    END;
  116. END;
  117.  
  118. PROCEDURE removeall;
  119. VAR
  120.    dummy : Longint;
  121. BEGIN
  122.    dummy := TR_EasyRequest(Triton_App,'Sure you want to remove all files?',
  123.                                       '_Remove|_Cancel',TAGS(
  124.                                       TREZ_LockProject,longint(Project),
  125.                                       TREZ_Title,longstr('Delete all?'),
  126.                                       TREZ_Activate,longint(byte(True)),
  127.                                       TAG_END));
  128.    IF dummy = 1 THEN BEGIN
  129.       ClearList(mylist);
  130.       TR_UpdateListView(Project,LibListGadID,mylist);
  131.       disablegads;
  132.    END;
  133. END;
  134.  
  135. PROCEDURE savethelist;
  136. VAR
  137.    dummy : BOOLEAN;
  138. BEGIN
  139.    dummy := ListToFile('Ram:fpclistoffiles',mylist);
  140. END;
  141.  
  142. PROCEDURE movedown;
  143. VAR
  144.    num : INTEGER;
  145.    mynode : pFPCNode;
  146. BEGIN
  147.    num := TR_GetValue(project,LibListGadID);
  148.    IF num < (NodesInList(mylist)-1) THEN BEGIN
  149.       mynode := GetNodeNumber(mylist,num);
  150.       IF mynode <> NIL THEN BEGIN
  151.           MoveNodeDown(mylist,mynode);
  152.           TR_UpdateListView(Project,LibListGadID,mylist);
  153.           TR_SetValue(Project,LibListGadID,num + 1);
  154.       END;
  155.    END;
  156. END;
  157.  
  158. PROCEDURE moveup;
  159. VAR
  160.    num : Longint;
  161.    mynode : pFPCNode;
  162. BEGIN
  163.    num := TR_GetValue(project,LibListGadID);
  164.    IF num > 0 THEN BEGIN
  165.       mynode := GetNodeNumber(mylist,num);
  166.       IF mynode <> NIL THEN BEGIN
  167.           MoveNodeUp(mylist,mynode);
  168.           TR_UpdateListView(Project,LibListGadID,mylist);
  169.           TR_SetValue(Project,LibListGadID,num-1);
  170.       END;
  171.    END;
  172. END;
  173.  
  174. PROCEDURE do_demo;
  175. VAR
  176.     close_me : BOOLEAN;
  177.     trmsg : pTR_Message;
  178.     dummy : Longint;
  179.  
  180. BEGIN
  181.     ProjectStart;
  182.                WindowID(1);
  183.                WindowPosition(TRWP_CENTERDISPLAY);
  184.                WindowTitle('TritonListViewDemo in FPC Pascal');
  185.                   HorizGroupAC;
  186.                      Space;
  187.                      VertGroupAC;
  188.                      Space;
  189.                      NamedSeparator('List of files');
  190.                         Space;
  191.                         ListSSM(mylist,LibListGadID,0,0,25);
  192.                         Space;
  193.                      EndGroup;
  194.                      Space;
  195.                      VertSeparator;
  196.                      Space;
  197.                      SetTRTag(TRGR_Vert, TRGR_ALIGN OR TRGR_FIXHORIZ);
  198.                         Space;
  199.                         Button('_Add...',AddGadID);
  200.                         SpaceS;
  201.                         Button('_Remove...',RemoveGadID);
  202.                         SpaceS;
  203.                         Button('Re_move All...',RemAllGadID);
  204.                         SpaceS;
  205.                         Button('_Up',UpGadID);
  206.                         SpaceS;
  207.                         Button('_Down',DownGadID);
  208.                         VertGroupS;Space;EndGroup;
  209.                         Button('_Ok',OkButton);
  210.                         SpaceS;
  211.                         Button('_Cancel',CancelButton);
  212.                         Space;
  213.                      EndGroup;
  214.                      Space;
  215.                   EndGroup;
  216.                EndProject;
  217.  
  218.     Project := TR_OpenProject(Triton_App,@tritontags);
  219.     IF Project <> NIL THEN BEGIN
  220.       disablegads;
  221.       close_me := FALSE;
  222.       WHILE NOT close_me DO BEGIN
  223.         dummy := TR_Wait(Triton_App,0);
  224.         REPEAT
  225.           trmsg := TR_GetMsg(Triton_App);
  226.           IF trmsg <> NIL THEN BEGIN
  227.             IF (trmsg^.trm_Project = Project) THEN BEGIN
  228.                CASE trmsg^.trm_Class OF
  229.                  TRMS_CLOSEWINDOW : close_me := True;
  230.                  TRMS_ERROR:        WriteLN(TR_GetErrorString(trmsg^.trm_Data));
  231.                  TRMS_ACTION :
  232.                  BEGIN
  233.                  CASE trmsg^.trm_ID OF
  234.                    AddGadID : addfiles;
  235.                    UpGadID : moveup;
  236.                    DownGadID : movedown;
  237.                    RemoveGadID : removelib;
  238.                    RemAllGadID : removeall;
  239.                    OkButton : BEGIN savethelist; close_me := True; END;
  240.                    CancelButton : close_me := True;
  241.                  END;
  242.                END;
  243.                ELSE
  244.                END;
  245.             END;
  246.             TR_ReplyMsg(trmsg);
  247.           END
  248.         UNTIL close_me OR (trmsg = NIL);
  249.       END;
  250.     END ELSE WriteLN(TR_GetErrorString(TR_GetLastError(Triton_App)));
  251. END;
  252.  
  253.  
  254. BEGIN  { Main }
  255.         Triton_App := TR_CreateApp(TAGS(
  256.                        TRCA_Name,longstr('Triton ListView Demo'),
  257.                        TRCA_LongName,longstr('Demo of ListView in Triton, made in FPC Pascal'),
  258.                        TRCA_Version,longstr('0.01'),
  259.                        TRCA_Info,longstr('Uses tritonsupport'),
  260.                        TRCA_Release,longstr('1'),
  261.                        TRCA_Date,longstr('03-02-1998'),
  262.                        TAG_END));
  263.         if Triton_App <> nil then begin
  264.         path := @pdummy;
  265.         StrpCopy(path,'sys:');
  266.         CreateList(mylist);
  267.         CreateList(llist);
  268.         readinlist;
  269.         do_demo;
  270.         CleanExit('',0);
  271.      END
  272.      ELSE CleanExit('Can''t create application',20);
  273. END.
  274.  
  275.  
  276.                 
  277.                                          
  278.  
  279.